home *** CD-ROM | disk | FTP | other *** search
/ Nebula 1 / Nebula One.iso / Utilities / Unix / satan-1.1.1 / perl / html.pl < prev    next >
Perl Script  |  1996-04-24  |  10KB  |  475 lines
  1. #!/usr/local/bin/perl
  2. #
  3. # version 1, Thu Mar 23 21:53:31 1995, last mod by wietse
  4. #
  5.  
  6. #
  7. # Run an off-the-shelf HTML client against a dedicated HTML server.  The
  8. # server executes PERL files that are specified in HTML requests.
  9. #
  10. # Authentication is magic-cookie style via the file system.  This should
  11. # be good enough: the client-server conversation never goes over the
  12. # network so the magic cookie cannot be stolen by a network sniffer.
  13. # 
  14. # Values in POST attribute-value lists are assigned to the corresponding
  15. # global PERL variables.  See &process_html_request() for details.
  16. #
  17.  
  18. sub html {
  19.     local($helper, $wd, $host);
  20.  
  21.     #
  22.     # Start the HTML server and generate the initial cookie for
  23.     # client-server authentication.
  24.     #
  25.     $running_from_html = 1;
  26.     chmod 0700, <~/.mosaic*>;    # Yuck!
  27.     chmod 0700, <~/.netsca*>;    # Yuck!
  28.     chmod 0700, <~/.MCOM*>;        # Yuck!
  29.     &start_html_server();
  30.     &make_password_seed();
  31.  
  32.     #
  33.     # These strings are used in, among others, PERL-to-HTML scripts.
  34.     #
  35.     $wd = `pwd`;
  36.     chop $wd;
  37.     $html_root = "$wd/html";
  38.     $start_page = "satan.html";
  39.     $THIS_HOST = &getfqdn(&hostname());
  40.     die "Can't find my own hostname: set \$dont_use_nslookup in $SATAN_CF\n"
  41.         unless $THIS_HOST;
  42.     $HTML_ROOT = "file://localhost$html_root";
  43.     $HTML_SERVER = "http://$THIS_HOST:$html_port/$html_password/$html_root";
  44.     $HTML_STARTPAGE = "$HTML_ROOT/$start_page";
  45.  
  46.     #
  47.     # Some obscurity. The real security comes from magic cookies.
  48.     #
  49.     $html_client_addresses = find_all_addresses($THIS_HOST) ||
  50.         die "Unable to find all my network addresses\n";
  51.  
  52.     for (<$html_root/*.pl>) {
  53.         s/\.pl$//;
  54.         unlink "$_.html";
  55.         open(HTML, ">$_.html")
  56.             || die "cannot write $_.html: $!\n";
  57.         select HTML;
  58.         do "$_.pl";
  59.         close HTML;
  60.         select STDOUT;
  61.         die $@ if $@;
  62.     }
  63.  
  64.     #
  65.     # Fork off the HTML client, and fork off a server process that
  66.     # handles requests from that client. The parent process waits
  67.     # until the client exits and terminates the server.
  68.     #
  69.     print "Starting $MOSAIC...\n" if $debug;
  70.  
  71.     if (($client = fork()) == 0) {
  72.         foreach (keys %ENV) {
  73.             delete $ENV{$_} if (/proxy/i && !/no_proxy/i);
  74.         }
  75.         exec($MOSAIC, "$HTML_STARTPAGE") 
  76.             || die "cannot exec $MOSAIC: $!";
  77.     } 
  78.     if (($server = fork()) == 0) {
  79.         if (($helper = fork()) == 0) {
  80.             alarm 3600;
  81.             &patience();
  82.         }
  83.         &init_satan_data();
  84.         &read_satan_data() unless defined($opt_i);
  85.         kill 'TERM',$helper;
  86.         $SIG{'PIPE'} = 'IGNORE';
  87.         for (;;) {
  88.             accept(CLIENT, SOCK) || die "accept: $!";
  89.             select((select(CLIENT), $| = 1)[0]);
  90.             &process_html_request();
  91.             close(CLIENT);
  92.         }
  93.     }
  94.  
  95.     #
  96.     # Wait until the client terminates, then terminate the server.
  97.     #
  98.     close(SOCK);
  99.     waitpid($client, 0);
  100.     kill('TERM', $server);
  101.     exit;
  102. }
  103.  
  104. #
  105. # Compute a hard to predict number for client-server authentication. Exploit
  106. # UNIX parallelism to improve unpredictability. We use MD5 only to compress
  107. # the result.
  108. #
  109. sub make_password_seed {
  110.     local($command);
  111.  
  112.     die "Cannot find $MD5. Did you run a \"reconfig\" and \"make\"?\n"
  113.         unless -x "$MD5";
  114.     $command = "ps axl&ps -el&netstat -na&netstat -s&ls -lLRt /dev*&w";
  115.     open(SEED, "($command) 2>/dev/null | $MD5 |")
  116.         || die "cannot run password command: $!";
  117.     ($html_password = <SEED>) || die "password computation failed: $!";
  118.     close(SEED);
  119.     chop($html_password);
  120. }
  121.  
  122. #
  123. # Set up a listener on an arbitrary port. There is no good reason to
  124. # listen on a well-known port number.
  125. #
  126. sub start_html_server {
  127.     local($sockaddr, $proto, $junk);
  128.  
  129.     $sockaddr = 'S n a4 x8';
  130.     ($junk, $junk, $proto) = getprotobyname('tcp');
  131.     socket(SOCK, &AF_INET, &SOCK_STREAM, $proto) || die "socket: $!";
  132.     listen(SOCK, 1) || die "listen: $!";
  133.     ($junk, $html_port) = unpack($sockaddr, getsockname(SOCK));
  134. }
  135.  
  136. #
  137. # Process one client request.  We expect the client to send stuff that
  138. # begins with:
  139. #
  140. #    command /password/perl_script junk
  141. #
  142. # Where perl_script is the name of a perl file that is executed via
  143. # do "perl_script";
  144. #
  145. # In case of a POST command the values in the client's attribute-value
  146. # list are assigned to the corresponding global PERL variables.
  147. #
  148. sub process_html_request {
  149.     local($request, $command, $script, $magic, $url, $peer);
  150.     local(%args);
  151.  
  152.     #
  153.     # Parse the command and URL. Update the default file prefix.
  154.     #
  155.     $request = <CLIENT>;
  156.     print $request if $debug;
  157.     ($command, $url) = split(/\s+/, $request);
  158.     if ($command eq "" || $command eq "QUIT") {
  159.         return;
  160.     }
  161.  
  162.     ($junk, $magic, $script) = split(/\//, $url, 3);
  163.     ($script, $html_script_args) = split(',', $script, 2);
  164.     ($HTML_CWD = "file:$script") =~ s/\/[^\/]*$//;
  165.     $HTML_CMD="/$HTML_CMD";
  166.     $script="/$script";
  167.  
  168.     #
  169.     # Make sure they gave us the right magic number.
  170.     #
  171.     if ($magic ne $html_password) {
  172.         &bad_html_magic($request);
  173.         return;
  174.     }
  175.  
  176.     #
  177.     # Assume the password has leaked out when the following happens.
  178.     #
  179.     $peer = &get_peer_addr(CLIENT);
  180.     die "SATAN password from unauthorized client: $peer\n"
  181.         unless is_member_of($peer, $html_client_addresses);
  182.     die "Illegal URL: $url received from: $peer\n" 
  183.         if index($script, "..") >= $[
  184.         || index($script, "$html_root/") != $[
  185.         || $script !~ /\.pl$/;
  186.  
  187.     #
  188.     # Warn them when the browser leaks parent URLs to web servers.
  189.     #
  190.     while (<CLIENT>) {
  191.         if (!$cookie_leak_warning && /$html_password/) {
  192.             &cookie_leak_warning();
  193.             return;
  194.         }
  195.         last if (/^\s+$/);
  196.     }
  197.  
  198.     if ($command eq "GET") {
  199.         perl_html_script($script);
  200.     } elsif ($command eq "POST") {
  201.  
  202.         #
  203.         # Process the attribute-value list.
  204.         #
  205.         if ($_ = <CLIENT>) {
  206.             s/\s+$//;
  207.             s/^/\n/;
  208.             s/&/\n/g;
  209.             $html_post_attributes = '';
  210.             $* = 1;
  211.             for (split(/(%[0-9][0-9A-Z])/, $_)) {
  212.                 $html_post_attributes .= (/%([0-9][0-9A-Z])/) ? 
  213.                     pack('c',hex($1)) : $_;
  214.             }
  215.             %args = ('_junk_', split(/\n([^=]+)=/, $html_post_attributes));
  216.             delete $args{'_junk_'};
  217.             for (keys %args) {
  218.                 print "\$$_ = $args{$_}\n" if $debug;
  219.                 ${$_} = $args{$_};
  220.             }
  221.             perl_html_script($script);
  222.         } else {
  223.             &bad_html_form($script);
  224.         }
  225.     } else {
  226.         &bad_html_command($request);
  227.     }
  228. }
  229.  
  230.  
  231. #
  232. # Map IP to string.
  233. #
  234. sub inet_ntoa {
  235.     local($ip) = @_;
  236.     local($a, $b, $c, $d);
  237.  
  238.     ($a, $b, $c, $d) = unpack('C4', $ip);
  239.     return "$a.$b.$c.$d";
  240. }
  241.  
  242. #
  243. # Look up peer address and translate to string form.
  244. #
  245. sub get_peer_addr {
  246.     local($peer) = @_;
  247.     local($junk, $inet);
  248.  
  249.     ($junk, $junk, $inet) = unpack('S n a4', getpeername($peer));
  250.     return &inet_ntoa($inet);
  251. }
  252.  
  253. #
  254. # Wrong magic number.
  255. #
  256. sub bad_html_magic {
  257.     local($request) = @_;
  258.     local($peer);
  259.  
  260.     $peer = &get_peer_addr(CLIENT);
  261.     print STDERR "bad request from $peer: $request\n";
  262.  
  263.         print CLIENT <<EOF
  264. <HTML>
  265. <HEAD>
  266. <TITLE>Bad client authentication code</TITLE>
  267. <LINK REV="made" HREF="mailto:satan\@fish.com">
  268. </HEAD>
  269. <BODY>
  270. <H1>Bad client authentication code</H1>
  271. The command: <TT>$request</TT> was not properly authenticated.
  272. </BODY>
  273. </HTML>
  274. EOF
  275. }
  276.  
  277. #
  278. # Unexpected HTML command.
  279. #
  280. sub bad_html_command {
  281.     local($request) = @_;
  282.  
  283.     print CLIENT <<EOF
  284. <HTML>
  285. <HEAD>
  286. <TITLE>Unknown command</TITLE>
  287. <LINK REV="made" HREF="mailto:satan\@fish.com">
  288. </HEAD>
  289. <BODY>
  290. <H1>Unknown command</H1>
  291. The command <TT>$request<TT> was not recognized.
  292. </BODY>
  293. </HTML>
  294. EOF
  295. }
  296.  
  297. #
  298. # Execute PERL script with extreme prejudice.
  299. #
  300. sub perl_html_script {
  301.     local($script) = @_;
  302.  
  303.     if (! -e $script) {
  304.         print CLIENT <<EOF
  305. <HTML>
  306. <HEAD>
  307. <TITLE>File not found</TITLE>
  308. <LINK REV="made" HREF="mailto:satan\@fish.com">
  309. </HEAD>
  310. <BODY>
  311. <H1>File not found</H1>
  312. The file <TT>$script</TT> does not exist or is not accessible.
  313. </BODY>
  314. </HTML>
  315. EOF
  316. ;        return;
  317.     }
  318.     do $script;
  319.     if ($@ && ($@ ne "\n")) {
  320.         print CLIENT <<EOF
  321. <HTML>
  322. <HEAD>
  323. <TITLE>Command failed</TITLE>
  324. <LINK REV="made" HREF="mailto:satan\@fish.com">
  325. </HEAD>
  326. <BODY>
  327. <H1>Command failed</H1>
  328. $@
  329. </BODY>
  330. </HTML>
  331. EOF
  332.     }
  333. }
  334.  
  335. #
  336. # Missing attribute list
  337. #
  338. sub bad_html_form {
  339.     local($script) = @_;
  340.  
  341.     print CLIENT <<EOF
  342. <HTML>
  343. <HEAD>
  344. <TITLE>No attribute list</TITLE>
  345. <LINK REV="made" HREF="mailto:satan\@fish.com">
  346. </HEAD>
  347. <BODY>
  348. <H1>No attribute list</H1>
  349.  
  350. No attribute list was found.
  351. </BODY>
  352. </HTML>
  353. EOF
  354. }
  355.  
  356. #
  357. # Scaffolding for stand-alone testing.
  358. #
  359. if ($running_under_satan == 1) {
  360.  
  361.     require 'perl/socket.pl';
  362.     require 'config/paths.pl';
  363.     require 'perl/hostname.pl';
  364.     require 'perl/getfqdn.pl';
  365.     require 'config/satan.cf';
  366.  
  367. } else {
  368.     $running_under_satan = 1;
  369.  
  370.     require 'perl/socket.pl';
  371.     require 'config/paths.pl';
  372.     require 'perl/hostname.pl';
  373.     require 'perl/getfqdn.pl';
  374.     require 'config/satan.cf';
  375.  
  376.     &html();
  377. }
  378.  
  379. #
  380. # Give them something to read while the server is initializing.
  381. #
  382. sub patience {
  383.     for (;;) {
  384.         accept(CLIENT, SOCK) || die "accept: $!";
  385.         <CLIENT>;
  386.         print CLIENT <<EOF
  387. <HTML>
  388. <HEAD>
  389. <TITLE>Initialization in progress</TITLE>
  390. <LINK REV="made" HREF="mailto:satan\@fish.com">
  391. </HEAD>
  392. <BODY>
  393. <H1>Initialization in progress</H1>
  394. SATAN is initializing, please try again later.
  395. </BODY>
  396. </HTML>
  397. EOF
  398. ;
  399.         close(CLIENT);
  400.     }
  401. }
  402.  
  403. # Look up all IP addresses listed for this host name, so that we can
  404. # filter out requests from non-local clients. Doing so offers no real
  405. # security, because network address information can be subverted.
  406. # 
  407. # All client-server communication security comes from the magic cookies
  408. # that are generated at program startup time. Client address filtering
  409. # adds an additional barrier in case the cookie somehow leaks out.
  410.  
  411. sub find_all_addresses {
  412.     local($host) = @_;
  413.     local($junk, $result);
  414.  
  415.     ($junk, $junk, $junk, $junk, @all_addresses) = gethostbyname($host);
  416.     for (@all_addresses) { $result .= &inet_ntoa($_) . " "; }
  417.     return $result;
  418. }
  419.  
  420. sub is_member_of {
  421.     local($elem, $list) = @_;
  422.  
  423.     for (split(/\s+/, $list)) { return 1 if ($elem eq $_); }
  424.     return 0;
  425. }
  426.  
  427. sub cookie_leak_warning {
  428.     print CLIENT <<EOF;
  429. <HTML>
  430. <HEAD>
  431. <TITLE>Warning - SATAN Password Disclosure</TITLE>
  432. <LINK REV="made" HREF="mailto:satan\@fish.com">
  433. </HEAD>
  434. <BODY>
  435. <H1><IMG SRC="$HTML_ROOT/images/satan.gif" ALT="[SATAN Image]">
  436. Warning - SATAN Password Disclosure</H1>
  437.  
  438. <HR>
  439.  
  440. <H3> 
  441.  
  442. Your Hypertext viewer may reveal confidential information when you
  443. contact remote WWW servers from within SATAN.
  444.  
  445. <p>
  446.  
  447. For this reason, SATAN advises you to not contact other WWW servers
  448. from within SATAN.
  449.  
  450. <p>
  451.  
  452. For more information, see <a
  453. href="$HTML_ROOT/tutorials/vulnerability/SATAN_password_disclosure.html">the
  454. SATAN vulnerability tutorial</a>.
  455.  
  456. <p>
  457.  
  458. This message will appear only once per SATAN session. 
  459.  
  460. <p>
  461.  
  462. In order to proceed, send a <i>reload</i> command (Ctrl-R with Lynx),
  463. or go back to the previous screen and select the same link or button
  464. again.
  465.  
  466. </H3>
  467.  
  468. </BODY>
  469. </HTML>
  470. EOF
  471.     $cookie_leak_warning = 1;
  472. }
  473.  
  474. 1;
  475.